home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE23 / SURVIVE / fmpymt.pas < prev    next >
Pascal/Delphi Source File  |  1997-05-19  |  5KB  |  188 lines
  1. unit fmpymt;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, Grids, DBGrids, DB, MultGrid, Mask,
  8.   fmAllo, uAllo;
  9.  
  10. type
  11.   TfrmPayment = class(TForm)
  12.     grpOutstandingCredits: TGroupBox;
  13.     grpPayment: TGroupBox;
  14.     grdPayment: TStringGrid;
  15.     grpTotals: TGroupBox;
  16.     edtTotalToPay: TEdit;
  17.     edtTotalPaid: TEdit;
  18.     edtBalanceDue: TEdit;
  19.     Label1: TLabel;
  20.     Label2: TLabel;
  21.     Label3: TLabel;
  22.     btnPost: TButton;
  23.     btnCancel: TButton;
  24.     dsCreditsOut: TDataSource;
  25.     btnAllocation: TButton;
  26.     grdCredits: TDBMultiGrid;
  27.     btnSelectAll: TButton;
  28.     btnClearAll: TButton;
  29.     procedure FormDestroy(Sender: TObject);
  30.     procedure btnCancelClick(Sender: TObject);
  31.     procedure grdCreditsSelected(Sender: TObject);
  32.     procedure grdPaymentSetEditText(Sender: TObject; ACol, ARow: Longint;
  33.       const Value: string);
  34.     procedure btnSelectAllClick(Sender: TObject);
  35.     procedure btnClearAllClick(Sender: TObject);
  36.     procedure btnAllocationClick(Sender: TObject);
  37.     procedure FormCreate(Sender: TObject);
  38.   private
  39.   public
  40.     CustomerNo: LongInt;
  41.     TotalToPay,
  42.     TotalPaid,
  43.     BalanceDue: Double;
  44.     AllocationInfo: TAllocationInfo;
  45.     
  46.     procedure PopulateForm;
  47.     procedure UpdateTotals; 
  48.   end;
  49.  
  50. var
  51.   frmPayment: TfrmPayment;
  52.  
  53. function ShowCreditPaymentDlg(aCustomerNo: LongInt): TModalResult;
  54.  
  55. implementation
  56.  
  57. {$R *.DFM}
  58.  
  59. uses
  60.   uBase, dmData;
  61.  
  62. function ShowCreditPaymentDlg(aCustomerNo: LongInt): TModalResult;
  63. begin
  64.   Application.CreateForm(TfrmPayment, frmPayment);
  65.   try
  66.     with frmPayment do begin
  67.       CustomerNo := aCustomerNo;
  68.       PopulateForm;
  69.       Result := ShowModal;
  70.     end;
  71.   finally
  72.     frmPayment.Release;
  73.   end;
  74. end;
  75.  
  76. procedure TfrmPayment.PopulateForm;
  77. var
  78.   I: Integer;
  79. begin
  80.   UpdateTotals;
  81.  
  82.   { Show the outstanding credits for this customer }
  83.   with dmDataModule.qryCreditsOutByCustomer do begin
  84.     ParamByName('CustNo').AsInteger := CustomerNo;
  85.     Open;
  86.   end;
  87.  
  88.   { Setup the payment method grid }
  89.   with grdPayment do begin
  90.     Cells[0, 0] := 'Method';
  91.     Cells[1, 0] := 'Amount';
  92.     with dmDataModule.PaymentMethodsList do begin
  93.       RowCount := Count + 1;
  94.       for I := 0 to Count - 1 do
  95.         Cells[0, I + 1] := Strings[I];
  96.     end;
  97.   end;
  98. end;
  99.  
  100. procedure TfrmPayment.UpdateTotals;
  101. begin
  102.   if TotalToPay = 0 then
  103.     BalanceDue := 0
  104.   else
  105.     BalanceDue := TotalToPay - TotalPaid;
  106.  
  107.   edtTotalToPay.Text := Format(mskCurrency, [TotalToPay]);
  108.   edtTotalPaid.Text := Format(mskCurrency, [TotalPaid]);
  109.   edtBalanceDue.Text := Format(mskCurrency, [BalanceDue]);
  110.   if BalanceDue < 0 then
  111.     edtBalanceDue.Color := clRed
  112.   else
  113.     edtBalanceDue.Color := TGroupBox(edtBalanceDue.Parent).Color;
  114. end;
  115.  
  116. procedure TfrmPayment.FormCreate(Sender: TObject);
  117. begin
  118.   AllocationInfo := TAllocationInfo.Create;
  119. end;
  120.  
  121. procedure TfrmPayment.FormDestroy(Sender: TObject);
  122. begin
  123.   dmDataModule.qryCreditsOutByCustomer.Close;
  124.   AllocationInfo.Free;
  125. end;
  126.  
  127. procedure TfrmPayment.btnCancelClick(Sender: TObject);
  128. begin
  129.   Close;
  130. end;
  131.  
  132. procedure TfrmPayment.grdCreditsSelected(Sender: TObject);
  133. var
  134.   DeltaAmount: LongInt;
  135. begin
  136. (*  if PaymentAllocation.Allocated then PaymentDeallocated := True;*)
  137.  
  138.   DeltaAmount := dmDataModule.qryCreditsOutByCustomer.FieldByName('BalanceDue').AsInteger;
  139.   if not grdCredits.Selected then DeltaAmount := -DeltaAmount;
  140.   TotalToPay := TotalToPay + DeltaAmount;
  141.   UpdateTotals;
  142.  
  143.   with dmDataModule.qryCreditsOutByCustomer do
  144.     if grdCredits.Selected then
  145.       AllocationInfo.Credits.Add(FieldByName('CreditNo').AsInteger,
  146.                                  Trunc(FieldByName('BalanceDue').AsFloat))
  147.     else
  148.       AllocationInfo.Credits.Delete(FieldByName('CreditNo').AsInteger);
  149. end;
  150.  
  151. procedure TfrmPayment.grdPaymentSetEditText(Sender: TObject; ACol,
  152.   ARow: Longint; const Value: string);
  153. var
  154.   I: Integer;
  155.   V: Integer;
  156. begin
  157.  
  158.   { Update total payment amount }
  159.   TotalPaid := 0;
  160.   if Value = '' then V := 0
  161.   else V := StrToInt(Value);
  162.   with grdPayment do begin
  163.     AllocationInfo.MethodAmounts[ARow - FixedRows] := V;
  164.     for I := 1 to RowCount do
  165.       if Cells[1, I] <> '' then
  166.         TotalPaid := TotalPaid + StrToFloat(Cells[1, I]);
  167.   end;
  168.  
  169.   UpdateTotals;
  170. end;
  171.  
  172. procedure TfrmPayment.btnSelectAllClick(Sender: TObject);
  173. begin
  174.   grdCredits.SelectAll(True);
  175. end;
  176.  
  177. procedure TfrmPayment.btnClearAllClick(Sender: TObject);
  178. begin
  179.   grdCredits.SelectAll(False);
  180. end;
  181.  
  182. procedure TfrmPayment.btnAllocationClick(Sender: TObject);
  183. begin
  184.   ShowPaymentAllocationDlg(AllocationInfo);
  185. end;
  186.  
  187. end.
  188.